home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / Goodies / CallBack / SCROLLCB.CLS < prev    next >
Text File  |  1997-06-09  |  3KB  |  107 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "ScrollBarDriver"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = False
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Option Explicit
  11. DefLng H
  12.  
  13. Private m_wndprcNext As Long
  14. Private hm_hWnd
  15. Private m_CallBack As CallBack
  16. Private m_VScroll As ScrollBar
  17. Private m_HScroll As ScrollBar
  18. Private m_MinMaxInfo As MINMAXINFO
  19.  
  20. Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal LParam As Long) As Long
  21.     Select Case uMsg
  22.         Case WM_VSCROLL
  23.             m_VScroll.Change wParam
  24.         Case WM_HSCROLL
  25.             m_HScroll.Change wParam
  26.         Case WM_GETMINMAXINFO
  27.             If CallWindowProc(m_wndprcNext, hWnd, uMsg, wParam, LParam) Then
  28.                 CopyMemory m_MinMaxInfo, ByVal LParam, Len(m_MinMaxInfo)
  29.                 With m_MinMaxInfo
  30.                     With .ptMinTrackSize
  31.                         .X = 380
  32.                         .Y = 350
  33.                     End With
  34.                 End With
  35.                 CopyMemory ByVal LParam, m_MinMaxInfo, Len(m_MinMaxInfo)
  36.                 WindowProc = 1
  37.                 Exit Function
  38.             End If
  39.     End Select
  40.     WindowProc = CallWindowProc(m_wndprcNext, hWnd, uMsg, wParam, LParam)
  41. End Function
  42.  
  43. Public Sub SubClass(ByVal hWnd As Long)
  44.     UnsubClass
  45.     m_wndprcNext = SetWindowLong(hWnd, GWL_WNDPROC, m_CallBack.ProcAddress)
  46.     If m_wndprcNext Then
  47.         m_CallBack.DebugProc = m_wndprcNext
  48.         hm_hWnd = hWnd
  49.         Set m_VScroll = New ScrollBar
  50.         With m_VScroll
  51.             .SB_TYPE = SB_VERT
  52.             .hWnd = hm_hWnd
  53.         End With
  54.         Set m_HScroll = New ScrollBar
  55.         With m_HScroll
  56.             .SB_TYPE = SB_HORZ
  57.             .hWnd = hm_hWnd
  58.         End With
  59.     End If
  60. End Sub
  61.  
  62. Public Sub UnsubClass()
  63.     If m_wndprcNext Then
  64.         SetWindowLong hm_hWnd, GWL_WNDPROC, m_wndprcNext
  65.         m_wndprcNext = 0
  66.         m_CallBack.DebugProc = m_wndprcNext
  67.         hm_hWnd = 0
  68.         Set m_VScroll = Nothing
  69.         Set m_HScroll = Nothing
  70.     End If
  71. End Sub
  72.  
  73. Public Property Set VScroll(ScrollBar As ScrollBar)
  74.     Set m_VScroll = ScrollBar
  75. End Property
  76.  
  77. Public Property Get VScroll() As ScrollBar
  78.     If m_VScroll Is Nothing Then
  79.         Set m_VScroll = New ScrollBar
  80.         With m_VScroll
  81.             .SB_TYPE = SB_VERT
  82.             .hWnd = hm_hWnd
  83.         End With
  84.     End If
  85.     Set VScroll = m_VScroll
  86. End Property
  87.  
  88. Public Property Set HScroll(ScrollBar As ScrollBar)
  89.     Set m_HScroll = ScrollBar
  90. End Property
  91.  
  92. Public Property Get HScroll() As ScrollBar
  93.     If m_HScroll Is Nothing Then
  94.         Set m_HScroll = New ScrollBar
  95.         With m_HScroll
  96.             .SB_TYPE = SB_HORZ
  97.             .hWnd = hm_hWnd
  98.         End With
  99.     End If
  100.     Set HScroll = m_HScroll
  101. End Property
  102.  
  103.  
  104. Private Sub Class_Initialize()
  105.     Set m_CallBack = NewCallBack(CBType_WNDPROC, Me, True)
  106. End Sub
  107.